home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol136 / pamcheck.bas < prev    next >
Encoding:
BASIC Source File  |  1986-12-15  |  20.7 KB  |  384 lines
  1. 10 REM  ***************************************************************************************************************
  2. 20 REM  'PAMCHECK'  PERSONAL ACCOUNTS MANAGER FOR RECORDING INCOME AND EXPENDITURES PLUS A SIMPLE BOOKKEEPING SYSTEM **
  3. 30 REM *****************************************************************************************************************
  4. 40 '
  5. 50 '    PAM - PERSONAL ACCOUNTS MANAGER  Version 1.1
  6. 60 '    COPYRIGHT 1983
  7. 70 '    S.E. BUTTON
  8. 80 '
  9. 90 '                                                    WARNING
  10. 100 ' This software (and manual) are both protected by U. S. Copyright Law (Title 17 United States Code).
  11. 110 ' Unauthorized reproduction and/or sales may result in imprisonment of up to 1 year and fines of up to $10,000 (17 USC 506).
  12. 120 ' Copyright infringers may be subject to civil liability.
  13. 130 '
  14. 140 REM     AUTHOR:   S. E. BUTTON
  15. 150 REM     WRITTEN:  1982-83
  16. 160 REM     COMPUTER: IBM PERSONAL COMPUTER
  17. 170 REM     LANGUAGE: DISK BASIC VER. 1.1
  18. 180 REM     MINIUMUM: 1 DISK, 64K RAM
  19. 190 REM     OPERATING SYSTEM: PC DOS
  20. 200 REM     MONOCHROME OR COLOR ADAPTER MAY BE USED
  21. 210 SCREEN 0,0,0: DEF SEG = &H40: IF (PEEK(&H10) AND &H30) = &H30 THEN WIDTH 80: IN$ = SPACE$(20) ELSE WIDTH 40: IN$ = ""
  22. 220 DEF SEG: POKE 106,0: DEFINT I-K: KEY OFF: FOR I = 1 TO 10: KEY I,"": NEXT I  'SET FUNCTION KEYS TO NULL
  23. 230 GOTO 370            '1ST LINE OF PROGRAM
  24. 240 REM ---------------------------------INDEX OF SUBROUTINE ENTRY POINTS-----------------------------------------------
  25. 250 GOTO 840            'DISPLAY MENU OF JOB CHOICES
  26. 260 GOSUB 1580: RETURN  'OPEN FILES #1, #2, #3
  27. 270 GOSUB 1830: RETURN  'MOVE FILE #2 FIELDS TO AN ARRAY
  28. 280 GOSUB 2190: RETURN  'MOVE ARRAY TO FILE #2 FIELDS
  29. 290 GOSUB 2570: RETURN  'CREATE A FILE #2 CHAINED RECORD
  30. 300 GOSUB 3000: RETURN  'GET REQUESTED FILE #1, #2 RECORD
  31. 310 GOSUB 3290: RETURN  'WRITE AUDIT TRAIL RECORD TO DISK
  32. 320 GOSUB 3360: RETURN  'DATA ENTRY VALIDATION ROUTINE
  33. 330 GOTO 3750           'PROGRAM END
  34. 340 REM ****************************************************************************************************************
  35. 350 REM             VARIABLES WHICH MAY BE CHANGED TO MEET USER REQUIREMENTS - SEE APPENDIX D  OF USER'S MANUAL
  36. 360 REM  *************************************************************************************************************
  37. 370 M1% = 200     'PAYEE'S DISKETTE FILE #1 & #2 MAXIMUM NO. OF RECORDS
  38. 380 M2% = 250     'INCREASE PAYEES FILE #2 TO THIS MAXIMUM WITH CHAINING RECORDS
  39. 390 M3% = 50      'ARRAY SIZE - SEE BELOW DIM STATEMENTS
  40. 400 M4% = 100     'ARRAY SIZE FOR CHECK NUMBERS - SEE BELOW DIM STATEMENT
  41. 410 M10% = 384    'NUMBER OF PRIME AREA RECORDS IN ACCOUNTS FILE
  42. 420 M11% = 32     'NUMBER OF OVERFLOW AREA RECORDS IN ACCOUNTS FILE
  43. 430 BOOKS$="Y"    'IS SIMPLE BOOKKEEPING SYSTEM OPTION USED? (Y OR N)
  44. 440 LACTM%=0      'CHART OF ACCOUNTS - ACCOUNT NUMBER
  45. 450 LACTS%=0      'CHART OF ACCOUNTS - ACCOUNT DISK RECORD NUMBER
  46. 460 LAMT=0        'CHART OF ACCOUNTS - ACCOUNT AMOUNT
  47. 470 '
  48. 480 '
  49. 490 '
  50. 500 '
  51. 510 '
  52. 520 '
  53. 530 '
  54. 540 REM  **************************************************************************************************************
  55. 550 DIM CHEK1%(M3%), CHEK2$(M3%)
  56. 560 DIM CHEK3$(M3%), CHEK4(M3%), CHEK5%(M3%)
  57. 570 DIM CKNO%(M4%)   'CHECK NUMBERS
  58. 580 DIM B$(28)  'ENGLISH PHRASE FOR DOLLARS
  59. 590 NOTNUM$ = "  Not a numeric entry, retry."
  60. 600 ENTER$ = CHR$(13)      'ENTER KEY
  61. 610 BKSPC$ = CHR$(8)       'BACKSPACE KEY
  62. 620 ESC$ = CHR$(27)        'ESCAPE KEY
  63. 630 Y = 1: X = 1           'CURSOR SAVE FIELDS FOR LINE & ROW
  64. 640 TRUE% = -1: FALSE% = 0 'TRUE/FALSE VALUES
  65. 650 FIELDMAX% = 0          'MAXIMUM DATA ENTRY FIELD LENGTH
  66. 660 DATA.CNT% = 0          'DATA ENTRY CHARACTER COUNT
  67. 670 DATU$ = ""             'DATA ENTRY FIELD
  68. 680 CK$ = ""               'DATA ENTRY INKEY$ CHARACTER FIELD
  69. 690 REM ****************************************************************************************************************
  70. 700 CLS: LOCATE 4,20
  71. 710 PRINT IN$;"IBM"
  72. 720 PRINT: LOCATE ,13: PRINT IN$;"Personal Computer"
  73. 730 LOCATE 9,6
  74. 740 PRINT IN$;"PAM - Personal Accounts Manager"
  75. 750 PRINT: LOCATE ,16: PRINT IN$;"Version 1.1"
  76. 760 LOCATE 14,7
  77. 770 PRINT IN$;"(C) Copyright S.E.Button 1983"
  78. 780 LOCATE 18,7: PRINT IN$;: COLOR 0,7
  79. 790 PRINT "Press any key to continue";
  80. 800 IF INKEY$ = "" THEN GOTO 800
  81. 810 REM  **************************************************************************************************************
  82. 820 REM                                    DISPLAY THE MENU OF JOB CHOICES
  83. 830 REM  **************************************************************************************************************
  84. 840 COLOR 7,0: CLS
  85. 850 PRINT: PRINT IN$;SPC(10);"JOB CHOICES MENU": PRINT
  86. 860 PRINT IN$;"  F1  Payee File Additions"
  87. 870 PRINT IN$;"  F2  Payee File Deletions"
  88. 880 PRINT IN$;"  F3  Payee File Changes"
  89. 890 PRINT IN$;"  F4  Check Printing":    READSW$="N"  'INITIALIZE READ SWITCH TO OFF
  90. 900 PRINT IN$;"  F5  Deposits, Interest Received and"
  91. 910 PRINT IN$;"         Withdrawal Recording"
  92. 920 PRINT IN$;"  F6  Checks Returned With Bank"
  93. 930 PRINT IN$;"         Statement Are Recorded"
  94. 940 PRINT IN$;"  F7  Bank Statement Reconciliation"
  95. 950 PRINT IN$;"  F8  Job is completed.  Stop This Run."
  96. 960 PRINT IN$;"  F9  Transfer to PAMUTILY Job Choices"
  97. 970 PRINT: PRINT: BEEP: PRINT IN$;: COLOR 0,7: PRINT "  Press Function Key for Job Choice. ";:
  98. 980 CK$ = INKEY$: IF CK$ = "" THEN 980
  99. 990 CK = ASC(CK$): IF CK = 0 THEN GOTO 1010
  100. 1000 BEEP: BEEP: GOTO 970  'NOT A FUNCTION KEY WHEN CK<>0
  101. 1010 FKEY = ASC(RIGHT$(CK$,1))  'TEST 2ND BYTE FOR WHICH FUNCTION KEY PRESSED
  102. 1020 IF FKEY > 58 AND FKEY < 69 THEN CHOICE = FKEY - 58: GOTO 1040
  103. 1030 GOTO 970
  104. 1040 PRINT CHOICE: COLOR 7,0
  105. 1050 IF (CHOICE>0) AND (CHOICE<10) THEN GOTO 1080
  106. 1060     PRINT IN$;: COLOR 31,0: PRINT "  Choices are F1 THRU F9, try again. ";: COLOR 7,0
  107. 1070     GOTO 970
  108. 1080 COLOR 7,0: ON CHOICE GOTO 1130,1170,1210,1250,1290,1330,1370,3750,1440
  109. 1090 GOTO 970  'MAKE JOB CHOICE
  110. 1100 REM  *************************************************************************************************************
  111. 1110 REM                                       CHAIN MERGE PROGRAM OVERLAYS
  112. 1120 REM  *************************************************************************************************************
  113. 1130 CLS
  114. 1140 LOCATE 12,3
  115. 1150 PRINT IN$;"Loading Program CHECKNEW Into Memory"
  116. 1160 CHAIN MERGE "A:CHECKNEW.BAS",4000,ALL,DELETE 4000-9000
  117. 1170 CLS
  118. 1180 LOCATE 12,3
  119. 1190 PRINT IN$;"Loading Program CHECKDEL Into Memory"
  120. 1200 CHAIN MERGE "A:CHECKDEL.BAS",4000,ALL,DELETE 4000-9000
  121. 1210 CLS
  122. 1220 LOCATE 12,3
  123. 1230 PRINT IN$;"Loading Program CHECKCHG Into Memory"
  124. 1240 CHAIN MERGE "A:CHECKCHG.BAS",4000,ALL,DELETE 4000-9000
  125. 1250 CLS
  126. 1260 LOCATE 12,3
  127. 1270 PRINT IN$;"Loading Program CHECKPRT Into Memory"
  128. 1280 CHAIN MERGE "A:CHECKPRT.BAS",4000,ALL,DELETE 4000-9000
  129. 1290 CLS
  130. 1300 LOCATE 12,3
  131. 1310 PRINT IN$;"Loading Program CHECKDIW Into Memory"
  132. 1320 CHAIN MERGE "A:CHECKDIW.BAS",4000,ALL,DELETE 4000-9000
  133. 1330 CLS
  134. 1340 LOCATE 12,3
  135. 1350 PRINT IN$;"Loading Program CHECKCLR Into Memory"
  136. 1360 CHAIN MERGE "A:CHECKCLR.BAS",4000,ALL,DELETE 4000-9000
  137. 1370 CLS
  138. 1380 LOCATE 12,3
  139. 1390 PRINT IN$;"Loading Program CHECKCIL Into Memory"
  140. 1400 CHAIN MERGE "A:CHECKCIL.BAS",4000,ALL,DELETE 4000-9000
  141. 1410 REM  **************************************************************************************************************
  142. 1420 REM                   LOAD "PAMUTILY" PROGRAM AND CHOOSE FROM 'UTILITY JOB CHOICES MENU'
  143. 1430 REM  *************************************************************************************************************
  144. 1440 CLOSE  'CLOSE PAYEE DISK FILES
  145. 1450 CLS
  146. 1460 LOCATE 12,1
  147. 1470 PRINT IN$;: COLOR 0,7: PRINT "  Insert PAMUTILY Diskette in Drive B": COLOR 7,0
  148. 1480 PRINT IN$;: COLOR 0,7: PRINT "  Press any key to continue";SPC(10): COLOR 7,0
  149. 1490 IF INKEY$ = "" THEN GOTO 1490
  150. 1500 PRINT: PRINT IN$;"  Loading Program PAMUTILY Into Memory"
  151. 1510 LOAD"B:PAMUTILY",R
  152. 1520 GOTO 1450  'TRY AGAIN
  153. 1530 REM  *************************************************************************************************************
  154. 1540 REM                                               SUBROUTINES
  155. 1550 REM  **************************************************************************************************************
  156. 1560 REM                       SUBROUTINE TO OPEN PAYEE FILES #1 AND #2 AND AUDIT TRAIL FILE #3
  157. 1570 REM  **************************************************************************************************************
  158. 1580 CLOSE  'BE SURE FILES ARE NOT OPEN FROM PREVIOUS PROCESSING
  159. 1590 OPEN "A:PAYEE.MAS" AS #1 LEN=128
  160. 1600 OPEN "A:CHECK.REC" AS #2 LEN=128
  161. 1610 OPEN "A:AUDTRAIL.REC" FOR APPEND AS #3
  162. 1620 ON ERROR GOTO 3160
  163. 1630 REM  **************************************************************************************************************
  164. 1640 REM                          PAYEE MASTER FILE #1 FIELDS IN THE I/O BUFFER
  165. 1650 REM  **************************************************************************************************************
  166. 1660 FIELD #1, 4 AS P1$,1 AS F1$,30 AS A1$,30 AS A2$,21 AS A3$,9 AS A4$,30 AS D1$,1 AS G1$,1 AS G2$,1 AS G3$
  167. 1670 FIELD #1,95 AS DUM9$,4 AS S1$,4 AS S2$,4 AS S3$,4 AS S4$,13 AS S4B$,2 AS S5$,2 AS S6$
  168. 1680 REM  *************************************************************************************************************
  169. 1690 REM                     PAYEE CHECK RECORDS FILE #2 FIELDS IN THE I/O BUFFER
  170. 1700 REM  *************************************************************************************************************
  171. 1710 FIELD #2,4 AS P2$,1 AS F2$,2 AS V11$,1 AS V12$,8 AS V13$,4 AS V14$
  172. 1720 FIELD #2,20 AS DUM1$,2 AS V21$,1 AS V22$,8 AS V23$,4 AS V24$
  173. 1730 FIELD #2,35 AS DUM2$,2 AS V31$,1 AS V32$,8 AS V33$,4 AS V34$
  174. 1740 FIELD #2,50 AS DUM3$,2 AS V41$,1 AS V42$,8 AS V43$,4 AS V44$
  175. 1750 FIELD #2,65 AS DUM4$,2 AS V51$,1 AS V52$,8 AS V53$,4 AS V54$
  176. 1760 FIELD #2,80 AS DUM5$,2 AS V61$,1 AS V62$,8 AS V63$,4 AS V64$
  177. 1770 FIELD #2,95 AS DUM6$,2 AS V71$,1 AS V72$,8 AS V73$,4 AS V74$
  178. 1780 FIELD #2,110 AS DUM7$,2 AS V81$,1 AS V82$,8 AS V83$,4 AS V84$,1 AS M$,2 AS L$
  179. 1790 RETURN
  180. 1800 REM  **************************************************************************************************************
  181. 1810 REM                 SUBROUTINE TO MOVE FILE #2 CHECK RECORDS FIELDS TO THE CHECK DATA ARRAYS
  182. 1820 REM  *************************************************************************************************************
  183. 1830 CHEK1%(1) = CVI(V11$)
  184. 1840 CHEK1%(2) = CVI(V21$)
  185. 1850 CHEK1%(3) = CVI(V31$)
  186. 1860 CHEK1%(4) = CVI(V41$)
  187. 1870 CHEK1%(5) = CVI(V51$)
  188. 1880 CHEK1%(6) = CVI(V61$)
  189. 1890 CHEK1%(7) = CVI(V71$)
  190. 1900 CHEK1%(8) = CVI(V81$)
  191. 1910 CHEK2$(1) = V12$
  192. 1920 CHEK2$(2) = V22$
  193. 1930 CHEK2$(3) = V32$
  194. 1940 CHEK2$(4) = V42$
  195. 1950 CHEK2$(5) = V52$
  196. 1960 CHEK2$(6) = V62$
  197. 1970 CHEK2$(7) = V72$
  198. 1980 CHEK2$(8) = V82$
  199. 1990 CHEK3$(1) = V13$
  200. 2000 CHEK3$(2) = V23$
  201. 2010 CHEK3$(3) = V33$
  202. 2020 CHEK3$(4) = V43$
  203. 2030 CHEK3$(5) = V53$
  204. 2040 CHEK3$(6) = V63$
  205. 2050 CHEK3$(7) = V73$
  206. 2060 CHEK3$(8) = V83$
  207. 2070 CHEK4(1) = CVS(V14$)
  208. 2080 CHEK4(2) = CVS(V24$)
  209. 2090 CHEK4(3) = CVS(V34$)
  210. 2100 CHEK4(4) = CVS(V44$)
  211. 2110 CHEK4(5) = CVS(V54$)
  212. 2120 CHEK4(6) = CVS(V64$)
  213. 2130 CHEK4(7) = CVS(V74$)
  214. 2140 CHEK4(8) = CVS(V84$)
  215. 2150 RETURN
  216. 2160 REM  ************************************************************************************************************
  217. 2170 REM                 SUBROUTINE TO MOVE THE CHECK DATA ARRAYS TO THE I/O BUFFER OF FILE #2
  218. 2180 REM  ************************************************************************************************************
  219. 2190 RSET V11$ = MKI$(CHEK1%(1))
  220. 2200 RSET V21$ = MKI$(CHEK1%(2))
  221. 2210 RSET V31$ = MKI$(CHEK1%(3))
  222. 2220 RSET V41$ = MKI$(CHEK1%(4))
  223. 2230 RSET V51$ = MKI$(CHEK1%(5))
  224. 2240 RSET V61$ = MKI$(CHEK1%(6))
  225. 2250 RSET V71$ = MKI$(CHEK1%(7))
  226. 2260 RSET V81$ = MKI$(CHEK1%(8))
  227. 2270 LSET V12$ = CHEK2$(1)
  228. 2280 LSET V22$ = CHEK2$(2)
  229. 2290 LSET V32$ = CHEK2$(3)
  230. 2300 LSET V42$ = CHEK2$(4)
  231. 2310 LSET V52$ = CHEK2$(5)
  232. 2320 LSET V62$ = CHEK2$(6)
  233. 2330 LSET V72$ = CHEK2$(7)
  234. 2340 LSET V82$ = CHEK2$(8)
  235. 2350 RSET V13$ = CHEK3$(1)
  236. 2360 RSET V23$ = CHEK3$(2)
  237. 2370 RSET V33$ = CHEK3$(3)
  238. 2380 RSET V43$ = CHEK3$(4)
  239. 2390 RSET V53$ = CHEK3$(5)
  240. 2400 RSET V63$ = CHEK3$(6)
  241. 2410 RSET V73$ = CHEK3$(7)
  242. 2420 RSET V83$ = CHEK3$(8)
  243. 2430 RSET V14$ = MKS$(CHEK4(1))
  244. 2440 RSET V24$ = MKS$(CHEK4(2))
  245. 2450 RSET V34$ = MKS$(CHEK4(3))
  246. 2460 RSET V44$ = MKS$(CHEK4(4))
  247. 2470 RSET V54$ = MKS$(CHEK4(5))
  248. 2480 RSET V64$ = MKS$(CHEK4(6))
  249. 2490 RSET V74$ = MKS$(CHEK4(7))
  250. 2500 RSET V84$ = MKS$(CHEK4(8))
  251. 2510 RETURN
  252. 2520 REM  ************************************************************************************************************
  253. 2530 REM               SUBROUTINE TO CREATE NEXT FILE #2 TRANSACTION RECORD IN THIS PAYEE'S CHAIN
  254. 2540 REM  ************************************************************************************************************
  255. 2550 REM                          GET BANK STATEMENT RECORD IF NOT IN MEMORY ALREADY
  256. 2560 REM  **************************************************************************************************************
  257. 2570 IF F1$ = "$" THEN GOTO 2650
  258. 2580 GET #1,1 'GET BANK STATEMENT FILE #1 RECORD
  259. 2590 IF F1$="$" THEN GOTO 2650
  260. 2600     COLOR 7,0: PRINT IN$;"  The Bank Statement Record has been"
  261. 2610     PRINT IN$;"  overlayed in File #1, Record #1"
  262. 2620     PRINT IN$;"  by Payee # ";P1$
  263. 2630     PRINT IN$;: COLOR 31,0: PRINT "  Correct FILE then rerun this job": COLOR 7,0
  264. 2640     GOTO 3750  'CANCEL THIS RUN
  265. 2650 CHANE%=CVI(S5$)  'NEXT AVAILABLE CHAIN ADRESS FROM FILE #1 BANK STATEMENT RECORD
  266. 2660 IF (CHANE%>M1%) AND (CHANE%<(M2%+1)) THEN GOTO 2730
  267. 2670     COLOR 7,0: PRINT IN$;"  Invalid next available Chain"
  268. 2680     PRINT IN$;"  Address in Bank Statement Record"
  269. 2690     PRINT IN$;: PRINT USING "  Chaining field has Record No. ####";CHANE%
  270. 2700     PRINT IN$;"  Valid Chaining Records are ";M1%+1;"-";M2%: BEEP: BEEP
  271. 2710     PRINT IN$;: COLOR 31,0: PRINT "  Correct FILE then rerun this job": COLOR 7,0
  272. 2720     GOTO 3750  'CANCEL THIS RUN
  273. 2730 LSET L$=MKI$(CHANE%) 'PUT CHAIN ADDRESS ON PAYEE'S PREVIOUS FILE #2 RECORD
  274. 2740 PUT #2,SVADDRS%
  275. 2750 WORK%=CHANE%+1  'INCREMENT CHAIN
  276. 2760 RSET S5$=MKI$(WORK%)  'MASTER ADDRESS FIELD ON FILE #1 BANK STATEMENT RECORD.
  277. 2770 PUT #1,1 'WRITE BANK STATEMENT FILE #1 RECORD TO DISKETTE
  278. 2780 GET #2,CHANE%  'GET THE FILE #2 RECORD FOR PAYEE'S NEXT CHAINING RECORD ***
  279. 2790 SVADDRS%=CHANE%  'SAVE FILE #2 RECORD ADDRESS
  280. 2800 IF ASC(F2$)=255 THEN GOTO 2850
  281. 2810     COLOR 7,0: PRINT IN$;: PRINT USING "  Record #### in use ";CHANE%
  282. 2820     PRINT IN$;"  Correct FILE then rerun this job"
  283. 2830     PRINT IN$;: COLOR 31,0: PRINT "  Restart with this transaction": COLOR 7,0
  284. 2840     GOTO 3750  'CANCEL THIS RUN
  285. 2850 RSET P2$=SAVEP2$
  286. 2860 LSET F2$=CHR$(2)
  287. 2870 LSET L$ = MKI$(0) 'INIT. CHAIN ADDRESS TO ZERO
  288. 2880 LSET V12$ = SPACE$(1) 'INIT. ACTIVITY FIELDS TO SPACE
  289. 2890 LSET V22$ = SPACE$(1)
  290. 2900 LSET V32$ = SPACE$(1)
  291. 2910 LSET V42$ = SPACE$(1)
  292. 2920 LSET V52$ = SPACE$(1)
  293. 2930 LSET V62$ = SPACE$(1)
  294. 2940 LSET V72$ = SPACE$(1)
  295. 2950 LSET V82$ = SPACE$(1)
  296. 2960 RETURN
  297. 2970 REM  ************************************************************************************************************
  298. 2980 REM                    SUBROUTINE TO GET THE REQUESTED FILE #1 AND FILE #2 RECORDS
  299. 2990 REM  ************************************************************************************************************
  300. 3000 CLS
  301. 3010 COLOR 7,0: PRINT IN$;"  Press the ENTER KEY only & return to"
  302. 3020 PRINT IN$;"  the Job Choices Menu display"
  303. 3030 PRINT IN$;SPC(18);"or"
  304. 3040 BEEP: PRINT IN$;"  Enter Payee's Diskette Record No."
  305. 3050 PRINT IN$;"  (Key leading zeros, when needed.)"
  306. 3060 PRINT: PRINT IN$;"  For example:     008  ";: Y = CSRLIN: X = POS(0)
  307. 3070 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 320
  308. 3080 IF DATU$ = "" THEN CLOSE: GOTO 840  'IF NULL FIELD CLOSE FILES AND GO TO DISPLAY MENU
  309. 3090 REC% = VAL(DATU$)
  310. 3100 IF (REC%<1) OR (REC%>M1%) THEN PRINT IN$;: COLOR 31,0: PRINT "  An incorrect entry, try again";: GOTO 3070
  311. 3110 GET #1,REC%:  GET #2,REC%
  312. 3120 RETURN
  313. 3130 REM  ************************************************************************************************************
  314. 3140 REM                                       ERROR HANDLING SUBROUTINE
  315. 3150 REM  ************************************************************************************************************
  316. 3160 IF ERR=27 THEN COLOR 31,0: PRINT IN$;"  Printer is not ON": PRINT IN$;"  or is out of paper": COLOR 7,0: RESUME
  317. 3170 IF ERR=24 THEN COLOR 31,0: PRINT IN$;"  Printer not READY!!!": BEEP: BEEP: COLOR 7,0: RESUME
  318. 3180 IF ERR=25 THEN COLOR 31,0: PRINT IN$;"  Check PRINTER and DISK are READY!!!": BEEP: BEEP: COLOR 7,0: RESUME
  319. 3190 ERM1$ = "  Field allocation is"
  320. 3200 ERM2$ = "  greater than record length"
  321. 3210 ERM3$ = "  correct program, then restart"
  322. 3220 IF ERR=50 AND ERL=1660 THEN  COLOR 31,0: PRINT IN$;"  FILE #1";ERM1$: PRINT IN$;ERM2$: PRINT IN$;ERM3$: COLOR 7,0: END
  323. 3230 IF ERR=50 AND ERL=1780 THEN  COLOR 31,0: PRINT IN$;"  FILE #2";ERM1$: PRINT IN$;ERM2$: PRINT IN$;ERM3$: COLOR 7,0: END
  324. 3240 ON ERROR GOTO 0
  325. 3250 STOP
  326. 3260 REM  ************************************************************************************************************
  327. 3270 REM                      SUBROUTINE TO WRITE AUDIT TRAIL RECORD TO ACTIVITY LOG FILE
  328. 3280 REM  ************************************************************************************************************
  329. 3290 DA$ = DATE$:  TI$ = TIME$
  330. 3300 WRITE #3,DA$,TI$,TC$,CN%,AC$,TD$,PA%,PC$,PA$,TAMT,LACTM%,LACTS%,LAMT,BDIW,BAMT
  331. 3310 RETURN
  332. 3320 REM  **************************************************************************************************************
  333. 3330 REM                                   SUBROUTINE TO VALIDATE DATA ENTRY
  334. 3340 REM  **************************************************************************************************************
  335. 3350 SOUND 50,4         'TONE TO SIGNAL REENTER DATA
  336. 3360 LOCATE Y,X: COLOR 0,7
  337. 3370 DEF SEG = &H40
  338. 3380 POKE &H17,(PEEK(&H17) OR &H60)  'TURN NUM LOCK AND CAPS LOCK ON
  339. 3390 DEF SEG
  340. 3400 POKE 106,0
  341. 3410 PRINT "[";STRING$(FIELDMAX%,"-");"]"
  342. 3420 DATU$ = ""         'SET DATA ENTRY FIELD TO NULL
  343. 3430 DATA.CNT% = 0      'SET DATA ENTRY COUNT FIELD TO ZERO
  344. 3440 LOCATE Y,X+1       'SET CURSOR TO FIRST PRINT POSITION
  345. 3450 IF INKEY$ <> "" THEN GOTO 3450  'CLEAR KEYSTROKE BUFFER
  346. 3460 CK$ = INKEY$: IF CK$ = "" THEN GOTO 3460
  347. 3470 IF CK$ = ENTER$ THEN GOTO 3600
  348. 3480 IF CK$ = BKSPC$ THEN GOSUB 3650: GOTO 3450        'ERASE LAST CHARACTER ENTERED
  349. 3490 IF CK$ = ESC$ THEN GOTO 3350  'REENTER ALL DATA
  350. 3500 CK = ASC(CK$): IF CK = 0 THEN BEEP: BEEP: GOTO 3450  'DISALLOW SPECIAL KEYS
  351. 3510 IF NOT NUM.ONLY% THEN GOTO 3560  'ALPHAMERIC FIELD IF NOT TRUE
  352. 3520 IF CK >= ASC("0") AND CK <= ASC("9") THEN GOTO 3560  'VALID NUMERIC
  353. 3530 IF NOT DEC.MINUS% THEN GOTO 3550
  354. 3540 IF CK$ = "." OR CK$ = "-" THEN GOTO 3560  'NUMERIC FIELD MAY HAVE DECIMAL OR MINUS
  355. 3550 SOUND 50,4: GOTO 3450   'INVALID KEY ENTRY
  356. 3560 DATA.CNT% = DATA.CNT% + 1   'INCREMENT DATA COUNT
  357. 3570 DATU$ = DATU$ + CK$: PRINT CK$;:  'APPEND ENTRY TO DATA FIELD AND PRINT
  358. 3580 IF DATA.CNT% >= FIELDMAX% THEN GOTO 3600
  359. 3590 GOTO 3450  'INPUT NEXT CHARACTER
  360. 3600 COLOR 7,0
  361. 3610 RETURN     'DATA ENTRY FIELD COMPLETED
  362. 3620 REM  --------------------------------------------------------------------------------------------------------------
  363. 3630 REM                         SUBROUTINE TO BACKSPACE AND ERASE DATA ENTRY CHARACTER
  364. 3640 REM  --------------------------------------------------------------------------------------------------------------
  365. 3650 IF DATA.CNT% = 0 THEN RETURN    'TEST IF BACKSPACE KEY IS FIRST DATA ENTRY KEY
  366. 3660 DATU$ = LEFT$(DATU$,DATA.CNT% - 1)  'DROP LAST KEYED ENTRY
  367. 3670 LOCATE Y,(X + DATA.CNT%)   'SET CURSOR TO ERASE POSITION
  368. 3680 PRINT CHR$(45);    'OVERLAY WITH DASH CHARACTER
  369. 3690 LOCATE Y,(X + DATA.CNT%)   'SET CURSOR FOR POSITION JUST ERASED
  370. 3700 DATA.CNT% = DATA.CNT% - 1  'DECREMENT COUNT
  371. 3710 RETURN
  372. 3720 REM  *************************************************************************************************************
  373. 3730 REM                                              PROGRAM END
  374. 3740 REM  ************************************************************************************************************
  375. 3750 IF FKEY <> 66 THEN COLOR 31,0: BEEP: BEEP: PRINT IN$;"  PAMCHECK program cancelled":  CLOSE: COLOR 7,0: END
  376. 3760 CLS
  377. 3770 LOCATE 12,1
  378. 3780 PRINT IN$;"  'PAMCHECK' program normal End-of-Job"
  379. 3790 CLOSE: END
  380. 3800 REM  ************************************************************************************************************
  381. 4000 GOTO 4000 'CHAIN MERGE AREA FIRST STATEMENT
  382. 9000 GOTO 9000 'CHAIN MERGE AREA LAST STATEMENT
  383. 9010 GOTO 9010 'STATEMENT FOLLOWING CHAIN MERGE AREA
  384.